home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / chasm.arc / COM2DATA.BAS < prev    next >
Encoding:
BASIC Source File  |  1983-04-08  |  5.1 KB  |  125 lines
  1. 1000 '******************************************
  2. 1010 '* PROGRAM COM2DATA  Version 1.0          *
  3. 1020 '*                                        *
  4. 1030 '* (1983) by David Whitman                *
  5. 1040 '*                                        *
  6. 1050 '* Reads a .COM format file and produces  *
  7. 1060 '* a file of DATA statements, which may   *
  8. 1070 '* be merged into a BASIC program.        *
  9. 1080 '******************************************
  10. 1090 '
  11. 1095 'print title page
  12. 1100   GOSUB 5000
  13. 1110 '
  14. 1120 'set up error trapping, declare all integers
  15. 1130  ON ERROR GOTO 6000: DEFINT A-Z
  16. 1140 '
  17. 1150 'open input file
  18. 1160   LOCATE 1,1: GOSUB 4000: INPUT "Name of COM file? [.com] ",C$
  19. 1170   IF C$ = "" THEN BEEP: GOTO 1160
  20. 1180   'if no extension, add default
  21. 1190     IF INSTR(C$,".") = 0                                                               THEN IN$ = C$ + ".com"                                                          ELSE IN$ = C$: C$ = LEFT$(C$,INSTR(C$,".")-1)
  22. 1191   'test if file exists
  23. 1192     OPEN IN$ FOR INPUT AS #1: CLOSE #1
  24. 1193   'and open it
  25. 1200     OPEN IN$ AS #1 LEN=1: FIELD #1, 1 AS BYTE$
  26. 1210 '
  27. 1220 'open output file
  28. 1230   LOCATE 3,1: GOSUB 4000: PRINT "Name for DATA file? ["; C$; ".dat] ";
  29. 1240   INPUT "", D$
  30. 1250   'default to input name with extension .dat
  31. 1260      IF D$ = "" THEN D$ = C$ + ".dat"
  32. 1270   OPEN D$ FOR OUTPUT AS #2
  33. 1280 '
  34. 1290 'get starting line number
  35. 1291 GOSUB 4000
  36. 1300  LOCATE 5,1: INPUT "Starting line number? [1000] ", L$
  37. 1310  'scan for non-numeric digits, bitch if so
  38. 1320  FOR I = 1 TO LEN(L$)
  39. 1330    N$ = MID$(L$,I,1)
  40. 1340    IF INSTR("0123456789", N$) = 0                                                     THEN LOCATE 5,1: BEEP: PRINT SPACE$(79): GOTO 1300
  41. 1350    NEXT I
  42. 1360  IF L$ = ""                                                                        THEN LINENUM = 1000                                                             ELSE LINENUM = VAL(L$)
  43. 1370  IF LINENUM <= 0 THEN LOCATE 5,1: BEEP: PRINT SPACE$(79): GOTO 1300
  44. 1380 '
  45. 1390 'set display width and number of data entrys per line
  46. 1400 'users with 40 column displays, edit appropriately
  47. 1410   WIDTH.OF.DISPLAY = 80: ENTRYS.PER.LINE = 10
  48. 1430 '
  49. 1440 'whew! now do it.
  50. 1444 CLS: GOSUB 4000: GOSUB 4000
  51. 1445 LOCATE 10, (WIDTH.OF.DISPLAY-7)/2: COLOR 16,7: PRINT"*WORKING*": COLOR 7,0
  52. 1450 ENTRYS.USED = 0: NUMBYTES = 0
  53. 1455 GET 1
  54. 1460 WHILE NOT EOF(1)
  55. 1490   'and send it to output file
  56. 1500    GOSUB 1550
  57. 1506    GET 1
  58. 1510   WEND
  59. 1520 '
  60. 1530 'Clean up
  61. 1535 'if any data not written yet, lop off trailing comma and write it.
  62. 1540  IF ENTRYS.USED > 0 THEN PRINT#2, LEFT$(BUFFER$,LEN(BUFFER$)-1)
  63. 1543 FOR I = 1 TO 3: SOUND 500*I,3: NEXT: SOUND 550,5: SOUND 800,3
  64. 1544 CLS
  65. 1545 SYSTEM
  66. 1550 '******************************************
  67. 1560 '* SUBROUTINE OUTPUT                      *
  68. 1570 '*                                        *
  69. 1580 '* Builds up DATA statements in buffer.   *
  70. 1590 '* Dumps buffer to output file when full. *
  71. 1600 '******************************************
  72. 1610 '
  73. 1620 'set up if necessary
  74. 1630  IF ENTRYS.USED = 0                                                                 THEN BUFFER$ = STR$(LINENUM) + " DATA"
  75. 1640 '
  76. 1650 'add new value to buffer
  77. 1660  H$ = RIGHT$("0" + HEX$(ASC(BYTE$)),2)
  78. 1670  BUFFER$ = BUFFER$ + " &H" + H$
  79. 1680 '
  80. 1690 'Is the line full yet?  Dump if so.
  81. 1700  ENTRYS.USED = ENTRYS.USED + 1
  82. 1710  IF ENTRYS.USED < ENTRYS.PER.LINE THEN BUFFER$ = BUFFER$ + ",": GOTO 1750
  83. 1720     PRINT#2, BUFFER$
  84. 1730     ENTRYS.USED = 0
  85. 1740     LINENUM = LINENUM + 10
  86. 1750  RETURN
  87. 1760 ON ERROR GOTO 0
  88. 4000 'one liner to make noise #1
  89. 4010 FOR I = 1 TO 3: SOUND 1000*I,1: NEXT I: RETURN
  90. 5000 '**********************
  91. 5010 '* SUBROUTINE TITLE   *
  92. 5020 '* Prints title page. *
  93. 5030 '**********************
  94. 5040 '
  95. 5050 SCREEN 0,0,0: WIDTH 80: KEY OFF: CLS: LOCATE 6,1,0
  96. 5060 PRINT TAB(18) "╔";STRING$(45,"═");"╗"
  97. 5070 PRINT TAB(18) "║                                             ║"
  98. 5080 PRINT TAB(18) "║          COM2DATA   version 1.0             ║"
  99. 5090 PRINT TAB(18) "║                                             ║"
  100. 5091 PRINT TAB(18) "║          (1983) by David Whitman            ║"
  101. 5094 PRINT TAB(18) "║                                             ║"
  102. 5097 PRINT TAB(18) "║  Machine language file conversion utility.  ║"
  103. 5160 PRINT TAB(18) "║                                             ║"
  104. 5170 PRINT TAB(18) "╚";STRING$(45,"═");"╝"
  105. 5180 LOCATE 23,27: PRINT "Hit any key to continue..."
  106. 5185 GOSUB 4000 'noise #1
  107. 5190 I$ = INKEY$: IF I$ = "" THEN 5190
  108. 5200 CLS
  109. 5210 RETURN
  110. 6000 '*****************
  111. 6010 '* Error handler *
  112. 6020 '*****************
  113. 6030 '
  114. 6040 IF ERR <> 53 THEN 6100
  115. 6050    COLOR 0,7: BEEP: LOCATE 2,1
  116. 6060    PRINT IN$; " not found.  Press Esc to exit, anything else to continue."
  117. 6070    IN$ = INKEY$: IF IN$ = "" THEN 6070
  118. 6075    IF IN$ = CHR$(27) THEN SYSTEM
  119. 6080    LOCATE ,1: COLOR 7,0: PRINT SPACE$(79)
  120. 6085    LOCATE 1,1: PRINT SPACE$(79): LOCATE ,1: RESUME 1160
  121. 6090 '
  122. 6100 IF ERR <> 6 OR ERL <> 1360 THEN 6200
  123. 6110    BEEP: LOCATE 5,1: PRINT SPACE$(79): LOCATE ,1: RESUME 1300
  124. 6200 ON ERROR GOTO 0
  125. F ERR <> 6 OR ERL <> 1360 T